home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / apel / emu-e20.el.z / emu-e20.el
Encoding:
Text File  |  1998-05-21  |  5.5 KB  |  201 lines
  1. ;;; emu-e20.el --- emu API implementation for Emacs 20
  2.  
  3. ;; Copyright (C) 1996,1997 Free Software Foundation, Inc.
  4.  
  5. ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
  6. ;; Version: $Id: emu-e20.el,v 7.26 1997/11/04 09:10:31 morioka Exp $
  7. ;; Keywords: emulation, compatibility, Mule
  8.  
  9. ;; This file is part of emu.
  10.  
  11. ;; This program is free software; you can redistribute it and/or
  12. ;; modify it under the terms of the GNU General Public License as
  13. ;; published by the Free Software Foundation; either version 2, or (at
  14. ;; your option) any later version.
  15.  
  16. ;; This program is distributed in the hope that it will be useful, but
  17. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19. ;; General Public License for more details.
  20.  
  21. ;; You should have received a copy of the GNU General Public License
  22. ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23. ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24. ;; Boston, MA 02111-1307, USA.
  25.  
  26. ;;; Commentary:
  27.  
  28. ;;    This module requires Emacs 20.1 or later.
  29.  
  30. ;;; Code:
  31.  
  32. (require 'emu-19)
  33.  
  34. (defun fontset-pixel-size (fontset)
  35.   (let* ((info (fontset-info fontset))
  36.      (height (aref info 1))
  37.      )
  38.     (cond ((> height 0) height)
  39.       ((string-match "-\\([0-9]+\\)-" fontset)
  40.        (string-to-number
  41.         (substring fontset (match-beginning 1)(match-end 1))
  42.         )
  43.        )
  44.       (t 0)
  45.       )))
  46.  
  47.  
  48. ;;; @ character set
  49. ;;;
  50.  
  51. ;; (defalias 'charset-columns 'charset-width)
  52.  
  53. (defun find-non-ascii-charset-string (string)
  54.   "Return a list of charsets in the STRING except ascii."
  55.   (delq 'ascii (find-charset-string string))
  56.   )
  57.  
  58. (defun find-non-ascii-charset-region (start end)
  59.   "Return a list of charsets except ascii
  60. in the region between START and END."
  61.   (delq 'ascii (find-charset-string (buffer-substring start end)))
  62.   )
  63.  
  64.  
  65. ;;; @ coding system
  66. ;;;
  67.  
  68. (defsubst-maybe find-coding-system (obj)
  69.   "Return OBJ if it is a coding-system."
  70.   (if (coding-system-p obj)
  71.       obj))
  72.  
  73. (defalias 'set-process-input-coding-system 'set-process-coding-system)
  74.  
  75.  
  76. ;;; @ MIME charset
  77. ;;;
  78.  
  79. (defun encode-mime-charset-region (start end charset)
  80.   "Encode the text between START and END as MIME CHARSET."
  81.   (let (cs)
  82.     (if (and enable-multibyte-characters
  83.          (setq cs (mime-charset-to-coding-system charset)))
  84.     (encode-coding-region start end cs)
  85.       )))
  86.  
  87. (defun decode-mime-charset-region (start end charset)
  88.   "Decode the text between START and END as MIME CHARSET."
  89.   (let (cs)
  90.     (if (and enable-multibyte-characters
  91.          (setq cs (mime-charset-to-coding-system charset)))
  92.     (decode-coding-region start end cs)
  93.       )))
  94.  
  95. (defun encode-mime-charset-string (string charset)
  96.   "Encode the STRING as MIME CHARSET."
  97.   (let (cs)
  98.     (if (and enable-multibyte-characters
  99.          (setq cs (mime-charset-to-coding-system charset)))
  100.     (encode-coding-string string cs)
  101.       string)))
  102.  
  103. (defun decode-mime-charset-string (string charset)
  104.   "Decode the STRING as MIME CHARSET."
  105.   (let (cs)
  106.     (if (and enable-multibyte-characters
  107.          (setq cs (mime-charset-to-coding-system charset)))
  108.     (decode-coding-string string cs)
  109.       string)))
  110.  
  111.  
  112. (defvar charsets-mime-charset-alist
  113.   '(((ascii)                        . us-ascii)
  114.     ((ascii latin-iso8859-1)                . iso-8859-1)
  115.     ((ascii latin-iso8859-2)                . iso-8859-2)
  116.     ((ascii latin-iso8859-3)                . iso-8859-3)
  117.     ((ascii latin-iso8859-4)                . iso-8859-4)
  118. ;;; ((ascii cyrillic-iso8859-5)                . iso-8859-5)
  119.     ((ascii cyrillic-iso8859-5)                . koi8-r)
  120.     ((ascii arabic-iso8859-6)                . iso-8859-6)
  121.     ((ascii greek-iso8859-7)                . iso-8859-7)
  122.     ((ascii hebrew-iso8859-8)                . iso-8859-8)
  123.     ((ascii latin-iso8859-9)                . iso-8859-9)
  124.     ((ascii latin-jisx0201
  125.         japanese-jisx0208-1978 japanese-jisx0208)    . iso-2022-jp)
  126.     ((ascii korean-ksc5601)                . euc-kr)
  127.     ((ascii chinese-gb2312)                . cn-gb-2312)
  128.     ((ascii chinese-big5-1 chinese-big5-2)        . cn-big5)
  129.     ((ascii latin-iso8859-1 greek-iso8859-7
  130.         latin-jisx0201 japanese-jisx0208-1978
  131.         chinese-gb2312 japanese-jisx0208
  132.         korean-ksc5601 japanese-jisx0212)        . iso-2022-jp-2)
  133.     ((ascii latin-iso8859-1 greek-iso8859-7
  134.         latin-jisx0201 japanese-jisx0208-1978
  135.         chinese-gb2312 japanese-jisx0208
  136.         korean-ksc5601 japanese-jisx0212
  137.         chinese-cns11643-1 chinese-cns11643-2)    . iso-2022-int-1)
  138.     ((ascii latin-iso8859-1 latin-iso8859-2
  139.         cyrillic-iso8859-5 greek-iso8859-7
  140.         latin-jisx0201 japanese-jisx0208-1978
  141.         chinese-gb2312 japanese-jisx0208
  142.         korean-ksc5601 japanese-jisx0212
  143.         chinese-cns11643-1 chinese-cns11643-2
  144.         chinese-cns11643-3 chinese-cns11643-4
  145.         chinese-cns11643-5 chinese-cns11643-6
  146.         chinese-cns11643-7)                . iso-2022-int-1)
  147.     ))
  148.  
  149.  
  150. ;;; @ character
  151. ;;;
  152.  
  153. (defalias 'char-length 'char-bytes)
  154.  
  155. (defalias 'char-columns 'char-width)
  156.  
  157.  
  158. ;;; @@ Mule emulating aliases
  159. ;;;
  160. ;;; You should not use them.
  161.  
  162. (defun char-category (character)
  163.   "Return string of category mnemonics for CHAR in TABLE.
  164. CHAR can be any multilingual character
  165. TABLE defaults to the current buffer's category table."
  166.   (category-set-mnemonics (char-category-set character))
  167.   )
  168.  
  169.  
  170. ;;; @ string
  171. ;;;
  172.  
  173. (defalias 'string-columns 'string-width)
  174.  
  175. (defalias 'sset 'store-substring)
  176.  
  177. (defun string-to-char-list (string)
  178.   "Return a list of which elements are characters in the STRING."
  179.   (let* ((len (length string))
  180.      (i 0)
  181.      l chr)
  182.     (while (< i len)
  183.       (setq chr (sref string i))
  184.       (setq l (cons chr l))
  185.       (setq i (+ i (char-bytes chr)))
  186.       )
  187.     (nreverse l)
  188.     ))
  189.  
  190. (defalias 'string-to-int-list 'string-to-char-list)
  191.  
  192.  
  193. ;;; @ end
  194. ;;;
  195.  
  196. (require 'emu-20)
  197.  
  198. (provide 'emu-e20)
  199.  
  200. ;;; emu-e20.el ends here
  201.